Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE01/CONSTRUC/CONVERT.PAS

Pascal/Delphi Source File | 1994-12-30 | 9.5 KB | 261 lines

unit Convert;
interface
uses SysUtils, Classes;

Type
  TConvert = class(TComponent)
               private
                 FValue: Word;

               protected
                 function GetHex: String;
                 function GetRoman: String;

                 procedure SetHex(Const Value: String);
                 procedure SetRoman(Const Rom: String);

               published
                 property Decimal: Word read FValue write FValue;
                 property Hex:   String read GetHex write SetHex;
                 property Roman: String read GetRoman write SetRoman;

               public
                 constructor Create(AOwner: TComponent); override;
             end {TConvert};

  procedure Register;

implementation

  constructor TConvert.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    FValue := 0;
  end {Create};

  function TConvert.GetHex: String;
  Const Digits: Array[0..$F] of Char = '0123456789ABCDEF';
  begin
    GetHex[0] := #4;
    GetHex[1] := Digits[Hi(FValue) SHR 4];
    GetHex[2] := Digits[Hi(FValue) AND $F];
    GetHex[3] := Digits[Lo(FValue) SHR 4];
    GetHex[4] := Digits[Lo(FValue) AND $F];
  end {GetHex};

  procedure TConvert.SetHex(Const Value: String);
  var code: Integer;
  begin
    if (Value[1] <> '$') then Val('$'+Value,FValue,code)
                         else Val(Value,FValue,code)
  end {SetHex};


  function TConvert.GetRoman: String; Assembler;
  ASM
        les   DI,@Result
        inc   DI
        push  DS
        lds   SI,self
        add   SI,FValue
        lodsw
        pop   DS
        mov   BX,AX        { BS := FValue;          }
        xor   AX,AX        { len := 0;              }

  @1000:cmp   BX,1000      { if W < 1000 then       }
        jb    @900         {   goto @900            }
                           { else begin             }
        sub   BX,1000      {   W := W - 1000;       }
        inc   AH           {   len := len + 1;      }
        mov   AL,'M'
        stosb              {   Int2Rom[len] := 'M'; }
                           { end;                   }
        jmp   @1000        { goto @1000;            }

  @900: cmp   BX,900       { if W < 900 then        }
        jb    @500         {   goto @500            }
                           { else begin             }
        sub   BX,900       {   W := W - 900;        }
        inc   AH           {   len := len + 1;      }
        mov   AL,'C'
        stosb              {   Int2Rom[len] := 'C'; }
        inc   AH           {   len := len + 1;      }
        mov   AL,'M'
        stosb              {   Int2Rom[len] := 'M'; }
                           { end;                   }
        jmp   @90          { goto @90;              }

  @400: cmp   BX,400       { if W < 400 then        }
        jb    @100         {   goto @100            }
                           { else begin             }
        sub   BX,400       {   W := W - 400;        }
        inc   AH           {   len := len + 1;      }
        mov   AL,'C'
        stosb              {   Int2Rom[len] := 'C'; }
        inc   AH           {   len := len + 1;      }
        mov   AL,'D'
        stosb              {   Int2Rom[len] := 'D'; }
                           { end;                   }
        jmp   @90          { goto @90;              }

  @500: cmp   BX,500       { if W < 500 then        }
        jb    @400         {   goto @400            }
                           { else begin             }
        sub   BX,500       {   W := W - 500;        }
        inc   AH           {   len := len + 1;      }
        mov   AL,'D'
        stosb              {   Int2Rom[len] := 'D'; }
                           { end;                   }
      { jmp   @100           goto @100;             }

  @100: cmp   BX,100       { if W < 100 then        }
        jb    @90          {   goto @90             }
                           { else begin             }
        sub   BX,100       {   W := W - 100;        }
        inc   AH           {   len := len + 1;      }
        mov   AL,'C'
        stosb              {   Int2Rom[len] := 'C'; }
                           { end;                   }
        jmp   @100         { goto @100;             }

   @90: cmp   BX,90        { if W < 90 then         }
        jb    @50          {   goto @50             }
                           { else begin             }
        sub   BX,90        {   W := W - 90;         }
        inc   AH           {   len := len + 1;      }
        mov   AL,'X'
        stosb              {   Int2Rom[len] := 'X'; }
        inc   AH           {   len := len + 1;      }
        mov   AL,'C'
        stosb              {   Int2Rom[len] := 'C'; }
                           { end;                   }
        jmp   @9           { goto @9;               }

   @40: cmp   BX,40        { if W < 40 then         }
        jb    @10          {   goto @10             }
                           { else begin             }
        sub   BX,40        {   W := W - 40;         }
        inc   AH           {   len := len + 1;      }
        mov   AL,'X'
        stosb              {   Int2Rom[len] := 'X'; }
        inc   AH           {   len := len + 1;      }
        mov   AL,'L'
        stosb              {   Int2Rom[len] := 'L'; }
                           { end;                   }
        jmp   @9           { goto @9;               }

   @50: cmp   BX,50        { if W < 50 then         }
        jb    @40          {   goto @40             }
                           { else begin             }
        sub   BX,50        {   W := W - 50;         }
        inc   AH           {   len := len + 1;      }
        mov   AL,'L'
        stosb              {   Int2Rom[len] := 'L'; }
                           { end;                   }
      { jmp   @10            goto @10;              }

   @10: cmp   BX,10        { if W < 10 then         }
        jb    @9           {   goto @9              }
                           { else begin             }
        sub   BX,10        {   W := W - 10;         }
        inc   AH           {   len := len + 1;      }
        mov   AL,'X'
        stosb              {   Int2Rom[len] := 'X'; }
                           { end;                   }
        jmp   @10          { goto @10;              }

    @9: cmp   BX,9         { if W < 9 then          }
        jb    @5           {   goto @5              }
                           { else begin             }
        sub   BX,9         {   W := W - 9;          }
        inc   AH           {   len := len + 1;      }
        mov   AL,'I'
        stosb              {   Int2Rom[len] := 'I'; }
        inc   AH           {   len := len + 1;      }
        mov   AL,'X'
        stosb              {   Int2Rom[len] := 'X'; }
                           { end;                   }
        jmp   @0           { goto @0;               }

    @4: cmp   BX,4         { if W < 4 then          }
        jb    @1           {   goto @1              }
                           { else begin             }
        sub   BX,4         {   W := W - 4;          }
        inc   AH           {   len := len + 1;      }
        mov   AL,'I'
        stosb              {   Int2Rom[len] := 'I'; }
        inc   AH           {   len := len + 1;      }
        mov   AL,'V'
        stosb              {   Int2Rom[len] := 'V'; }
                           { end;                   }
        jmp   @0           { goto @0;               }

    @5: cmp   BX,5         { if W < 5 then          }
        jb    @4           {   goto @4              }
                           { else begin             }
        sub   BX,5         {   W := W - 5;          }
        inc   AH           {   len := len + 1;      }
        mov   AL,'V'
        stosb              {   Int2Rom[len] := 'V'; }
                           { end;                   }
      { jmp   @1             goto @1;               }

    @1: cmp   BX,1         { if W < 1 then          }
        jb    @0           {   goto @0              }
                           { else begin             }
        dec   BX           {   W := W - 1;          }
        inc   AH           {   len := len + 1;      }
        mov   AL,'I'
        stosb              {   Int2Rom[len] := 'I'; }
                           { end;                   }
        jmp   @1           { goto @1;               }

    @0: les   DI,@Result
    {$IFOPT G+}
        shr   AX,8
    {$ELSE}
        mov   CL,8
        shr   AX,CL
    {$ENDIF}
        stosb              { Int2Rom[0] := Chr(len) }
  end {GetRoman};


  procedure TConvert.SetRoman(Const Rom: String);
  const value: Array['A'..'Z'] of Word =
       (0,0,100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10,0,0);
  var len: Byte absolute Rom;
      index,next: Char;
      teller: Integer;
      tmp: Word;
  begin
    tmp := 0;
    teller := 0;
    while (teller < len) do
    begin
      Inc(teller);
      index := UpCase(Rom[teller]); { upcase is needed to index value }
      if index in ['A'..'Z'] then
      begin
        next := UpCase(Rom[Succ(teller)]);
        if (next in ['A'..'Z']) and (value[index] < value[next]) then
        begin
          Inc(tmp,value[next]);
          Dec(tmp,value[index]);
          Inc(teller)
        end
        else Inc(tmp,value[index])
      end
    end;
    FValue := tmp
  end {SetRoman};


  procedure Register;
  begin
    RegisterComponents('Dr.Bob', [TConvert])
  end {Register};
end.